Primary Means of Transportation
To understand the primary means of transportation around Chicago,
data from the U.S. Census Bureau American Community Survey in 2023 was
used for each block group aggregated over 5 years. Maps were constructed
by clipping block groups into the Chicago city boundary. The block
groups and city boundary were in NAD 83 so they were reprojected to WGS
84 to make the geo-coded trauma locations and for the r5 routing
engine.
Population, race and ethnicity, transportation means to work, vehicle
availability, and number of households below the poverty level were
pulled from the 2023 ACS via the tigris package and converted to
percentages.
###----------------------city and block group boundaries---------------------###
# Illinois cities and towns
il_places <- places(state = 'IL',
year = 2023,
cb = T) #smooths boundry
# filter for Chicago
chiCity <- il_places %>%
filter(NAME == 'Chicago')
# Cook County Cencus Block Groups
cook_bgs <- get_acs(geography = 'block group',
year = 2023,
variables = c(
# Population
total_pop = "B01003_001",
# Race
total_race = "B03002_001",
white = "B03002_003",
black = "B03002_004",
native = "B03002_005",
asian = "B03002_006",
pacific_islander = "B03002_007",
hispanic = "B03002_012",
other = "B03002_008",
# Transportation to work
commute_total = "B08301_001",
drive_alone = "B08301_003",
carpool = "B08301_004",
public_transit = "B08301_010",
bus = "B08301_011",
cta_train = "B08301_012",
metra_train = "B08301_013",
walked = "B08301_019",
bicycle = "B08301_018",
home = "B08301_021",
# Vehicle availability
hh_total = "B25044_001",
hh_own = "B25044_002",
hh_rent = "B25044_009",
own_no_vehicle = "B25044_003",
rent_no_vehicle = "B25044_010",
# Income level below povery level
pov_total = "B17010_001",
pov = "B17010_002"),
state = 'IL',
county = 'Cook',
survey = 'acs5',
output = 'wide',
geometry = 'T')
# calculate percent below federal poverty line and percent race/ethnicity
cook_bgs <- cook_bgs %>%
mutate(pwhite = round((whiteE / total_raceE)*100,2), #percentage non- hispanic white
pblack = round((blackE / total_raceE)*100, 2), #percentage non- hispanic black
pasian = round((asianE / total_raceE)*100, 2), #percentage non- hispanic asian
phisp = round((hispanicE / total_raceE)*100, 2), #percentage hispanic
pother = round(((otherE + nativeE) / total_raceE)*100, 2), #percentage other
ppov = round((povE/pov_totalE)*100, 2), #percentage under poverty level
pdrive = round((drive_aloneE/commute_totalE)*100, 2), #percentage drive to work
ppubtrans = round((public_transitE/commute_totalE)*100, 2), #percentage take public transit to work
pbus = round((busE/commute_totalE)*100, 2), #percentage bus to work
pcta_train = round((cta_trainE/commute_totalE)*100, 2), #percentage take L to work
pmetra_train = round((metra_trainE/commute_totalE)*100, 2), #percentage take long distance train to work
pbike = round((bicycleE/commute_totalE)*100, 2), #percentage bike to work
pwalk = round((walkedE/commute_totalE)*100, 2), #percentage walk to work
pwo_vehicel = round(((own_no_vehicleE + rent_no_vehicleE)/hh_totalE)*100, 2), #percentage without a vehicle
) %>%
dplyr::select(GEOID, NAME, total_popE, pwhite, pblack,
pasian, phisp, pother, ppov,
pdrive, ppubtrans, pbus,
pcta_train, pmetra_train, pbike, pwalk, pwo_vehicel, geometry) #select key variables
# Clip tracts using Chicago city boundary
chi_bgs <- ms_clip(target = cook_bgs,
clip = chiCity,
remove_slivers = T)
chi_bgs <- st_make_valid(chi_bgs)
#check projections
st_crs(chiCity) # NAD83 (4269) - Geographic reference system
st_crs(chi_bgs) # NAD83 (4269) - Geographic reference system
st_crs(trauma_geo) # WGS 84 (4326) - Geographic reference system
#align to WGS 84
chiCity <- st_transform(chiCity, 4326)
chi_bgs <- st_transform(chi_bgs, 4326)
Box plots were constructed to visualize the distribution of
percentages of residents in each block group that do not have a car,
drive to work, and use public transportation to get to work. While the
percentage of people driving to work is fairly normal, the percentage
who take public transit and the percentage who do not have a car is not.
Therefore, I opted to display the data with Jenks breaks - this would
allow fair comparison across graphs without having to standardize
non-normal data.
I prefer the ggplot package over the tmap for such granular divisions
as block groups because I feel the resolution to be better. ggplot does
not have an automatic jenks function though, so i had to compute them
manually with the ClassInt package in R and specifically extract the
“breaks” from the classIntervals function. I then created a data frame
with categorized data by cutting each column by the computed jenks
breaks. I now had sorted data by jenks ready for ggplotting. While this
took extra time and research, the map appears cleaner than tmap.
###--------------------------means of transportation-------------------------###
#quick exploration of means of transportation to work
ggplot(data = chi_bgs,
mapping = aes(y = pdrive)) +
geom_boxplot(coef = 1.5)

ggplot(data = chi_bgs,
mapping = aes(y = ppubtrans)) +
geom_boxplot(coef = 1.5)

ggplot(data = chi_bgs,
mapping = aes(y = pwo_vehicel)) +
geom_boxplot(coef = 1.5)

#percentage of driving to work is fairly normal but the percentage who take public transit
#and the percentage who do not have a car is not; will use jenks to display
### --- plot with ggplot --- ###
#compute jenks
jenks_breaks_pdrive <- classIntervals(chi_bgs$pdrive, n = 5, style = "jenks")$brks
jenks_breaks_ppubtrans <- classIntervals(chi_bgs$ppubtrans, n = 5, style = "jenks")$brks
jenks_breaks_pwo_vehicle <- classIntervals(chi_bgs$pwo_vehicel, n = 5, style = "jenks")$brks
#categorize data frames
chi_bgs_jenks <- chi_bgs %>%
mutate(drive_cat = cut(pdrive, breaks = jenks_breaks_pdrive, include.lowest = TRUE, dig.lab = 5)) %>%
mutate(pubtrans_cat = cut(ppubtrans, breaks = jenks_breaks_ppubtrans, include.lowest = TRUE, dig.lab = 5)) %>%
mutate(wo_vehicle_cat = cut(pwo_vehicel, breaks = jenks_breaks_pwo_vehicle, include.lowest = TRUE, dig.lab = 5))
#plot with jenks
#percentage who drive
drive_map <- ggplot() +
geom_sf(
data = chi_bgs_jenks,
aes(fill = drive_cat),
color = NA) +
scale_fill_brewer(
palette = "OrRd",
name = "Percentage") +
labs(
title = "Percentage Who Drive to Work",
caption = "Source: ACS 2023 5-year estimates (Table B08301)") +
theme_minimal(base_size = 13) +
theme(
legend.position = c(0.95, 0.80),
legend.background = element_rect(
fill = "white",
color = "black"),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
plot.title = element_text(
face = "bold",
size = 16,
hjust = 0.5),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
#percentage who do not have a car
car_map <- ggplot() +
geom_sf(
data = chi_bgs_jenks,
aes(fill = wo_vehicle_cat),
color = NA) +
scale_fill_brewer(
palette = "OrRd",
name = "Percentage") +
labs(
title = "Percentage Who Do Not Have a Car",
caption = "Source: ACS 2023 5-year estimates (Table B25044)") +
theme_minimal(base_size = 13) +
theme(
legend.position = c(0.95, 0.80),
legend.background = element_rect(
fill = "white",
color = "black"),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
plot.title = element_text(
face = "bold",
size = 16,
hjust = 0.5),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
#percentage who do not have a car
pubtrans_map <- ggplot() +
geom_sf(
data = chi_bgs_jenks,
aes(fill = pubtrans_cat),
color = NA) +
scale_fill_brewer(
palette = "OrRd",
name = "Percentage") +
labs(
title = "Percentage Who Take Public Transit to Work",
caption = "Source: ACS 2023 5-year estimates (Table B08301)") +
theme_minimal(base_size = 13) +
theme(
legend.position = c(0.95, 0.80),
legend.background = element_rect(
fill = "white",
color = "black"),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
plot.title = element_text(
face = "bold",
size = 16,
hjust = 0.5),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())